unit uFrmPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, wwdbdatetimepicker;

type
  TFrmPrincipal = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    txtData: TwwDBDateTimePicker;
    txtChave: TEdit;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    txtChave1: TEdit;
    Label3: TLabel;
    txtData1: TwwDBDateTimePicker;
    procedure txtDataKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure txtChave1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmPrincipal: TFrmPrincipal;

implementation

{$R *.dfm}

function Crypto(pOrigem, pChaveStr: String;
  pChaveInt: Integer; pAcao: Boolean): String;
var KeyLen, KeyPos, Offset,
    SrcPos, SrcAsc, TmpSrcAsc : Integer;
    Dest : String;
begin
  if Trim(pOrigem) = '' then Exit;

  pChaveStr := 'rotcp';
  KeyLen    := Length(pChaveStr);
  KeyPos    := 0;

  if pAcao then begin
    Offset := pChaveInt;
    Dest   := Format('%1.2x',[Offset]);
    
    for SrcPos := 1 to Length(pOrigem) do begin
      SrcAsc := (Ord(pOrigem[SrcPos]) + Offset) MOD 255;
      if KeyPos < KeyLen then
        KeyPos := KeyPos + 1
      else
        KeyPos := 1;
        
      SrcAsc := SrcAsc xor Ord(pChaveStr[KeyPos]);
      Dest   := Dest + Format('%1.2x',[SrcAsc]);
      Offset := SrcAsc;
    end;
  end else begin
    Offset := StrToInt('$'+ Copy(pOrigem,1,2));
    SrcPos := 3;
    repeat
      SrcAsc := StrToInt('$'+ Copy(pOrigem,SrcPos,2));
      if KeyPos < KeyLen then
        KeyPos := KeyPos + 1
      else
        KeyPos := 1;

      TmpSrcAsc := SrcAsc xor Ord(pChaveStr[KeyPos]);
      if TmpSrcAsc <= Offset then
        TmpSrcAsc := 255 + TmpSrcAsc - Offset
      else
        TmpSrcAsc := TmpSrcAsc - Offset;

      Dest   := Dest + Chr(TmpSrcAsc);
      Offset := srcAsc;
      SrcPos := SrcPos + 2;
    until SrcPos >= Length(pOrigem);
  end;

  Result := Dest;
end;

procedure TFrmPrincipal.txtDataKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    Key := 0;

    if txtData.Date = 0 then begin
      txtChave.Clear;
      Exit;
    end;

    txtChave.Text := Crypto(txtData.Text, '254165', 200, True);
  end;
end;

procedure TFrmPrincipal.FormShow(Sender: TObject);
begin
  txtData.Date := Now;
end;

procedure TFrmPrincipal.txtChave1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_RETURN) then begin
    Key := 0;

    if txtChave1.Text = '' then begin
     txtData1.Text := '';
     Exit;
    end;

    txtData1.Date := StrToDate(Crypto(txtChave1.Text, '254165', 200, False));
  end;
end;

end.
